{-# LANGUAGE DeriveDataTypeable #-}
{-----------------------------------------------------------------
 
  this module contains some common function used by other modules
  that don't (yet) have their own category


  (c) 2008-2009 Markus Dittrich 
 
  This program is free software; you can redistribute it 
  and/or modify it under the terms of the GNU General Public 
  License Version 3 as published by the Free Software Foundation. 
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License Version 3 for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 59 Temple Place - Suite 330, 
  Boston, MA 02111-1307, USA.

--------------------------------------------------------------------}
 
-- | this module contains some common function used by other modules
-- that don't (yet) have their own category
module Helpers.Common ( defaultVersionToken
                      , find_package_paths
                      , get_categories
                      , show_version
                      , strip_category
                      , split_version_BS
                      , VersionToken(..)
                      ) where



-- imports
import Control.Monad(filterM, liftM)
import qualified Data.ByteString as B(append, ByteString, empty, null,
  tail)
import qualified Data.ByteString.Char8 as BC(pack)
import List(sort)
import Prelude
import System.Directory(doesDirectoryExist, getDirectoryContents)
import System.FilePath.Posix((</>), dropTrailingPathSeparator, 
  splitPath, takeFileName) 
import Text.Regex.PCRE((=~))


-- local imports
import Helpers.FileIO
import Parsers.Slot



-- some global and useful definitions

-- | current version of hark
harkVersion :: String
harkVersion = "0.3"



-- | data structure holding the pieces of an EAPI
-- version string, i.e. name-version:slot[useDep]
data VersionToken = VersionToken 
  { 
    dName    :: B.ByteString
  , dVersion :: B.ByteString
  , dSlot    :: B.ByteString
  , dUseDeps :: B.ByteString
  }


defaultVersionToken :: VersionToken
defaultVersionToken = VersionToken
  {
    dName    = B.empty
  , dVersion = B.empty
  , dSlot    = B.empty
  , dUseDeps = B.empty
  }



-- | token which signify the beginning of a version or
-- SLOT specifier
versionStartToken :: B.ByteString
versionStartToken = BC.pack "[-][0-9]"

slotStartToken :: B.ByteString
slotStartToken = BC.pack "[:]"

useDepStartToken :: B.ByteString
useDepStartToken = BC.pack "[[]"




-- | filter all category directories from main database 
-- directory
get_categories :: FilePath -> IO [FilePath]
get_categories path = 
  
  getDirectoryContents path
  >>= \rawContent ->

    let 
      content = filter_dot_dirs rawContent 
    in
      liftM (sort . map takeFileName) (filterM doesDirectoryExist $ 
                    map ( path </>) content)



-- | given a pattern and a list of search paths, try to strip
-- the category of the pattern. If one exists, restrict
-- the search to the single path in the list of filepaths
-- corresponding to the category.
strip_category :: String -> [FilePath] -> (String, [FilePath])
strip_category x [] = (x,[])
strip_category pattern paths 

  | length splitPattern == 2    = 
              (aName, filter (\x -> x =~ path :: Bool) paths )

  | otherwise                   = (pattern,paths)
  
  where 
    splitPattern = splitPath pattern
    path = dropTrailingPathSeparator $ (!!) splitPattern 0
    aName = (!!) splitPattern 1




-- | splits off the version string from the package name 
-- via regular expression
-- NOTE: This is a specialized version for ByteString
split_version_BS :: B.ByteString -> VersionToken
split_version_BS inString = 

  let
    -- split off use depend tokens if present
    (r1, _, use)    = inString =~ useDepStartToken 
                        :: (B.ByteString,B.ByteString,B.ByteString)

    -- split off the slot if present
    (r2, _, slot)   = r1 =~ slotStartToken 
                        :: (B.ByteString,B.ByteString,B.ByteString)

    -- split the rest into the name plus version if present
    (name, m, vers) = r2 =~ versionStartToken
                        :: (B.ByteString,B.ByteString,B.ByteString)
    in
      if B.null m 
        then
         defaultVersionToken {
                               dName = name
                             , dSlot = slot
                             , dUseDeps = use
                             }

        else
         defaultVersionToken {
                               dName = name
                             , dVersion = B.append (B.tail m) vers 
                             , dSlot = slot
                             , dUseDeps = use
                             }




-- | look for packages matching the searched for name in database
find_package_paths :: String -> [FilePath] -> IO [FilePath]
find_package_paths packageName paths = find_path [] paths

  where
    -- go through all categories and try to find a match
    find_path :: [FilePath] -> [FilePath] -> IO [FilePath]
    find_path acc [] = return acc
    find_path acc (dir:dirs) =
        
        retrieve_directory_contents dir 
        >>= \packages -> 

          -- NOTE: Slotted packages can lead to more than
          -- a single match in a category if only the
          -- package name is given
          match_package packageName packages dir >>= \matches ->
   
            case length matches of
              0 -> find_path acc dirs
              _ -> find_path (make_paths matches ++ acc) dirs

              where
                make_paths = map (\x -> dir ++ "/" ++ x) 



-- | check if a package is in a list of FilePaths
-- The following additional constraints apply:
-- 
--   * if the user specified only the package name we attempt 
--     to match entries in the pathList based on the name only. 
--   * if a version is supplied we do a full match only.
--   * if a slot dependency is supplied we only match packages
--     the have this exact slot
match_package :: String -> [FilePath] -> FilePath -> IO [FilePath]
match_package packageQuery pathList topDir = 

  -- if we have a full version we're good apart from stripping
  -- off the slot information in case it is present
  if not $ null aVersion 
     then 
       return $ filter (\x -> x == (aName ++ aVersion)) pathList
     else
       -- if we have a slot we only pick packages with
       -- a matching slot
       if not $ null aSlot
          then
            filterM (check_slot_name aName aSlot) pathList
          else
            -- only have the name was provided
            return $ filter (\x -> get_name x == aName) pathList


   where
     (aName, aVersion, aSlot) = split_version_slot packageQuery


     -- | in case the user supplied a slot we try to figure out
     -- retrieve the SLOT of the target package as well and
     -- make sure it matches.
     -- NOTE: We have to be prepared that some packges don't
     -- have a SLOT
     check_slot_name n s pkg =
       
       try_get_slot (topDir ++ "/" ++ pkg) >>= \pkgSlot ->
       case pkgSlot of
         Nothing  -> return (get_name pkg == n)
         Just val -> return $ (get_name pkg == n) 
                           && (val == BC.pack s)



     -- | splits a full package name request into the name,
     -- and possibly version and slot info
     split_version_slot theName = 

       let 
         -- split off the slot if present
         (r1, _, theSlot)  = theName =~ slotStartToken 
                           :: (String, String, String)

         -- split off the version if present
         (name, m, vers) = r1 =~ versionStartToken
                           :: (String, String, String)
       in
         (name, m ++ vers, theSlot)

                           
         
     -- | conveniece function to get at the name only
     get_name item = let
                       (theName, _, _) = split_version_slot item
                     in
                       theName



-- | function printing out the current version information
show_version :: IO ()
show_version = 

  do
    putStrLn $ "hark version " ++ harkVersion
    putStrLn "Copyright (C) 2008-2009 Markus Dittrich\n" 
    putStrLn "Please type 'man hark' for a detailed description"
    putStrLn "of hark's capabilities.\n"
    putStrLn "hark is distributed under the terms of the GNU General"
    putStrLn "Public License v3. There is NO warranty; not even for"
    putStrLn "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"

